home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / Src Code / TEEPREVI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-24  |  22.3 KB  |  768 lines
  1. {*******************************************}
  2. {    TeeChart & TeeTree PrintPreview Form   }
  3. {   Copyright (c) 1996-98 by David Berneda  }
  4. {*******************************************}
  5. {$I teedefs.inc}
  6. unit TeePrevi;
  7.  
  8. interface
  9.  
  10. uses
  11.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  12.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, TeeProcs
  13.   {$IFDEF D1}
  14.   , Spin, TeeUpDow
  15.   {$ELSE}
  16.   , ComCtrls
  17.   {$ENDIF}
  18.   ;
  19.  
  20. {$IFDEF TEEOCX}
  21. Const TeeMsg_OCXNoPrinter= 'There is no default printer.'+#13+
  22.                            'Use Windows Control Panel to add a Printer';
  23. {$ENDIF}
  24.  
  25. type
  26.   TOnChangeMarginsEvent=Procedure (Sender:TObject; DisableProportional:Boolean; Const NewMargins:TRect) of object;
  27.  
  28.   TeePreviewZones=( teePrev_None,
  29.                     teePrev_Left,
  30.                     teePrev_Top,
  31.                     teePrev_Right,
  32.                     teePrev_Bottom,
  33.                     teePrev_Image,
  34.                     teePrev_LeftTop,
  35.                     teePrev_RightTop,
  36.                     teePrev_LeftBottom,
  37.                     teePrev_RightBottom );
  38.  
  39.   TTeePreviewPage=class(TGraphicControl)
  40.   private
  41.     FAllowResize     : Boolean;
  42.     FAllowMove       : Boolean;
  43.     FAsBitmap        : Boolean;
  44.     FImage           : TCustomTeePanel;
  45.     FDragImage       : Boolean;
  46.     FOnChangeMargins : TOnChangeMarginsEvent;
  47.     FOldShowImage    : Boolean;
  48.     FPaperColor      : TColor;
  49.     FShowImage       : Boolean;
  50.     FShowMargins     : Boolean;
  51.  
  52.     { internal }
  53.     FDragged         : TeePreviewZones;
  54.     OldX             : Integer;
  55.     OldY             : Integer;
  56.     OldRect          : TRect;
  57.     ImageRect        : TRect;
  58.     PaperRect        : TRect;
  59.     Procedure SetShowMargins(Value:Boolean);
  60.     Procedure SetImage(Value:TCustomTeePanel);
  61.     Function GetPrintingBitmap:TBitmap;
  62.   protected
  63.     Procedure Paint; override;
  64.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  65.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  66.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  67.   public
  68.     Constructor Create(AOwner:TComponent); override;
  69.     Function CalcImagePrintMargins:TRect;
  70.     Procedure DrawPaper(ACanvas:TCanvas);
  71.     Procedure DrawBack(ACanvas:TCanvas);
  72.     Procedure DrawImage(ACanvas:TCanvas);
  73.     Procedure DrawMargins(ACanvas:TCanvas);
  74.     Function WhereIsCursor(x,y:Integer):TeePreviewZones;
  75.     Procedure Print;
  76.   published
  77.     property AllowResize:Boolean read FAllowResize write FAllowResize default True;
  78.     property AllowMove:Boolean read FAllowMove write FAllowMove default True;
  79.     property AsBitmap:Boolean read FAsBitmap write FAsBitmap;
  80.     property DragImage:Boolean read FDragImage write FDragImage default False;
  81.     property PaperColor:TColor read FPaperColor write FPaperColor;
  82.     property ShowImage:Boolean read FShowImage write FShowImage default True;
  83.     property ShowMargins:Boolean read FShowMargins write SetShowMargins default True;
  84.     property OnChangeMargins:TOnChangeMarginsEvent read FOnChangeMargins
  85.                                                    write FOnChangeMargins;
  86.     property Image:TCustomTeePanel read FImage write SetImage;
  87.   end;
  88.  
  89.   TChartPreview = class(TForm)
  90.     Panel1: TPanel;
  91.     Printers: TComboBox;
  92.     Label1: TLabel;
  93.     BSetupPrinter: TBitBtn;
  94.     Panel2: TPanel;
  95.     Orientation: TRadioGroup;
  96.     GBMargins: TGroupBox;
  97.     SETopMa: TEdit;
  98.     SELeftMa: TEdit;
  99.     SEBotMa: TEdit;
  100.     SERightMa: TEdit;
  101.     PrinterSetupDialog1: TPrinterSetupDialog;
  102.     ShowMargins: TCheckBox;
  103.     BReset: TButton;
  104.     ChangeDetailGroup: TGroupBox;
  105.     Label2: TLabel;
  106.     Label3: TLabel;
  107.     BClose: TButton;
  108.     Resolution: TScrollBar;
  109.     BPrint: TButton;
  110.     UDLeftMa: TUpDown;
  111.     UDTopMa: TUpDown;
  112.     UDRightMa: TUpDown;
  113.     UDBotMa: TUpDown;
  114.     CBProp: TCheckBox;
  115.     procedure FormShow(Sender: TObject);
  116.     procedure BSetupPrinterClick(Sender: TObject);
  117.     procedure PrintersChange(Sender: TObject);
  118.     procedure OrientationClick(Sender: TObject);
  119.     procedure SETopMaChange(Sender: TObject);
  120.     procedure SERightMaChange(Sender: TObject);
  121.     procedure SEBotMaChange(Sender: TObject);
  122.     procedure SELeftMaChange(Sender: TObject);
  123.     procedure ShowMarginsClick(Sender: TObject);
  124.     procedure FormCreate(Sender: TObject);
  125.     procedure BResetClick(Sender: TObject);
  126.     procedure ResolutionChange(Sender: TObject);
  127.     procedure BPrintClick(Sender: TObject);
  128.     procedure FormDestroy(Sender: TObject);
  129.     procedure BCloseClick(Sender: TObject);
  130.     procedure CBPropClick(Sender: TObject);
  131.   private
  132.     { Private declarations }
  133.     CreatingForm    : Boolean;
  134.     ChangingMargins : Boolean;
  135.     ChangingProp    : Boolean;
  136.     Procedure ResetMargins;
  137.   protected
  138.     procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  139.   public
  140.     { Public declarations }
  141.     PreviewPage     : TTeePreviewPage;
  142.     OldMargins      : TRect;
  143.     Procedure RefreshPage;
  144.     Procedure RecalcControls;
  145.     Procedure PreviewPageChangeMargins(Sender:TObject; DisableProportional:Boolean; Const NewMargins:TRect);
  146.     procedure ChangeMargin(UpDown:TUpDown; Var APos:Integer; OtherSide:Integer);
  147.   end;
  148.  
  149. Procedure ChartPreview(AOwner:TComponent; TeePanel:TCustomTeePanel);
  150.  
  151. implementation
  152.  
  153. {$R *.DFM}
  154. Uses Printers, TeCanvas;
  155.  
  156. Const TeePreviewCursors:Array[0..9] of TCursor=
  157.            ( crDefault, { none }
  158.              crHSplit,
  159.              crVSplit,
  160.              crHSplit,
  161.              crVSplit,
  162.              crTeeHand,
  163.              crSizeNWSE,
  164.              crSizeNESW,
  165.              crSizeNESW,
  166.              crSizeNWSE );
  167.  
  168. Procedure ChartPreview(AOwner:TComponent; TeePanel:TCustomTeePanel);
  169. Begin
  170.   {$IFDEF TEEOCX}
  171.   if (Printer.Printers.Count=0) or
  172.      (Printer.PrinterIndex=-1) then ShowMessage(TeeMsg_OCXNoPrinter)
  173.   else
  174.   {$ENDIF}
  175.   with TChartPreview.Create(AOwner) do
  176.   try
  177.     PreviewPage.Image:=TeePanel;
  178.     ShowModal;
  179.   finally
  180.     Free;
  181.     TeePanel.Repaint;
  182.   end;
  183. End;
  184.  
  185. { TeePreviewPage }
  186. Constructor TTeePreviewPage.Create(AOwner:TComponent);
  187. Begin
  188.   inherited Create(AOwner);
  189.   ControlStyle:=ControlStyle+[csOpaque];
  190.   FImage:=nil;
  191.   FDragImage:=False;
  192.   FShowMargins:=True;
  193.   FShowImage:=True;
  194.   FOldShowImage:=True;
  195.   FDragged:=teePrev_None;
  196.   FAsBitmap:=False;  { <-- as metafile by default }
  197.   FPaperColor:=clWhite;
  198.   FAllowResize:=True;
  199.   FAllowMove:=True;
  200. End;
  201.  
  202. Procedure TTeePreviewPage.Print;
  203. var tmpBitmap:TBitmap;
  204. Begin
  205.   if Assigned(FImage) then
  206.   Begin
  207.     Screen.Cursor:=crHourGlass;
  208.     try
  209.       if FAsBitmap then
  210.       begin
  211.         Printer.Title:=FImage.Name;
  212.         Printer.BeginDoc;
  213.         try
  214.           tmpBitmap:=GetPrintingBitmap;
  215.           try
  216.             Printer.Canvas.StretchDraw(FImage.ChartPrintRect,tmpBitmap);
  217.           finally
  218.             tmpBitmap.Free;
  219.           end;
  220.           Printer.EndDoc;
  221.         except
  222.         on Exception do
  223.         begin
  224.           Printer.Abort;
  225.           if Printer.Printing then Printer.EndDoc;
  226.           Raise;
  227.         end;
  228.         end;
  229.       end
  230.       else FImage.Print;
  231.     finally
  232.       Screen.Cursor:=crDefault;
  233.     end;
  234.   end;
  235. end;
  236.  
  237. Procedure TTeePreviewPage.DrawPaper(ACanvas:TCanvas);
  238. Begin
  239.   With ACanvas do
  240.   Begin
  241.     Pen.Style:=psSolid;
  242.     Pen.Color:=clBlack;
  243.     Brush.Color:=FPaperColor;
  244.     Pen.Width:=1;
  245.     With PaperRect do Rectangle(Left,Top,Right,Bottom);
  246.     Brush.Color:=clBlack;
  247.     With PaperRect do FillRect(Rect(Left+5,Bottom,Right+5,Bottom+4));
  248.     With PaperRect do FillRect(Rect(Right,Top+4,Right+5,Bottom+4));
  249.   end;
  250. end;
  251.  
  252. Procedure TTeePreviewPage.SetShowMargins(Value:Boolean);
  253. Begin
  254.   FShowMargins:=Value;
  255.   Invalidate;
  256. End;
  257.  
  258. Procedure TTeePreviewPage.SetImage(Value:TCustomTeePanel);
  259. Begin
  260.   FImage:=Value;
  261.   Invalidate;
  262. End;
  263.  
  264. Procedure TTeePreviewPage.DrawBack(ACanvas:TCanvas);
  265. Begin
  266.   with ACanvas do
  267.   Begin
  268.     Pen.Style:=psClear;
  269.     Brush.Style:=bsSolid;
  270.     Brush.Color:=Self.Color;
  271.     With ClientRect do Rectangle(Left,Top,Right,Bottom);
  272.   end;
  273. end;
  274.  
  275. Function TTeePreviewPage.CalcImagePrintMargins:TRect;
  276. var PaperWidth  : Longint;
  277.     PaperHeight : Longint;
  278. begin
  279.   With FImage.PrintMargins do
  280.   begin
  281.     RectSize(PaperRect,PaperWidth,PaperHeight);
  282.     result.Left  :=PaperRect.Left  +MulDiv(Left  ,PaperWidth,100);
  283.     result.Right :=PaperRect.Right -MulDiv(Right ,PaperWidth,100);
  284.     result.Top   :=PaperRect.Top   +MulDiv(Top   ,PaperHeight,100);
  285.     result.Bottom:=PaperRect.Bottom-MulDiv(Bottom,PaperHeight,100);
  286.   end;
  287. end;
  288.  
  289. Procedure TTeePreviewPage.Paint;
  290. Var PrinterWidth  : Longint;
  291.     PrinterHeight : Longint;
  292.  
  293.   Procedure CalcPaperRectangles;
  294.   Var R         : TRect;
  295.       tmpWidth  : Longint;
  296.       tmpHeight : Longint;
  297.   begin
  298.     PrinterWidth := Printer.PageWidth;
  299.     PrinterHeight:= Printer.PageHeight;
  300.  
  301.     R:=Rect(0,0,PrinterWidth,PrinterHeight);
  302.     if PrinterWidth<PrinterHeight then
  303.     Begin
  304.       tmpHeight:=ClientHeight-Round(10.0*ClientHeight/100.0);
  305.       if PrinterHeight>0 then
  306.         tmpWidth:=MulDiv(tmpHeight,PrinterWidth,PrinterHeight)
  307.       else
  308.         tmpWidth:=ClientWidth;
  309.       PaperRect.Left:=(ClientWidth-tmpWidth) div 2;
  310.       PaperRect.Right:=PaperRect.Left+tmpWidth;
  311.       PaperRect.Top:=Round(5.0*ClientHeight/100.0);
  312.       PaperRect.Bottom:=PaperRect.Top+tmpHeight;
  313.     end
  314.     else
  315.     Begin
  316.       tmpWidth:=ClientWidth-Round(10.0*ClientWidth/100.0);
  317.       if PrinterWidth>0 then
  318.         tmpHeight:=MulDiv(tmpWidth,PrinterHeight,PrinterWidth)
  319.       else
  320.         tmpHeight:=ClientHeight;
  321.  
  322.       PaperRect.Top:=(ClientHeight-tmpHeight) div 2;
  323.       PaperRect.Bottom:=PaperRect.Top+tmpHeight;
  324.       PaperRect.Left:=Round(5.0*ClientWidth/100.0);
  325.       PaperRect.Right:=PaperRect.Left+tmpWidth;
  326.     end;
  327.   end;
  328.  
  329. var tmp:TBitmap;
  330. Begin
  331.   inherited Paint;
  332.   CalcPaperRectangles;
  333.   ImageRect:=CalcImagePrintMargins;
  334.   tmp:=TBitmap.Create;
  335.   with tmp do
  336.   try
  337.     Width:=ClientRect.Right-ClientRect.Left;
  338.     Height:=ClientRect.Bottom-ClientRect.Top;
  339.     DrawBack(Canvas);
  340.     DrawPaper(Canvas);
  341.     if FShowMargins then DrawMargins(Canvas);
  342.     DrawImage(Canvas);
  343.     Self.Canvas.Draw(0,0,tmp);
  344.   finally
  345.     Free;
  346.   end;
  347. end;
  348.  
  349. Procedure TTeePreviewPage.DrawMargins(ACanvas:TCanvas);
  350. Begin
  351.   With ACanvas do
  352.   Begin
  353.     if (FPaperColor=clSilver) or (FPaperColor=clGray) then
  354.        Pen.Color:=clWhite
  355.     else
  356.        Pen.Color:=clSilver;
  357.     Pen.Style:=psDot;
  358.     Pen.Width:=1;
  359.     Brush.Style:=bsClear;
  360.     Brush.Color:=FPaperColor;
  361.     Pen.Mode:=pmNotXor;
  362.     SetBKMode(Handle,Transparent);
  363.     With ImageRect do
  364.     Begin
  365.       MoveTo(Left-1,PaperRect.Top);
  366.       LineTo(Left-1,PaperRect.Bottom);
  367.  
  368.       MoveTo(Right+1,PaperRect.Top);
  369.       LineTo(Right+1,PaperRect.Bottom);
  370.  
  371.       MoveTo(PaperRect.Left,Top-1);
  372.       LineTo(PaperRect.Right,Top-1);
  373.  
  374.       MoveTo(PaperRect.Left,Bottom+1);
  375.       LineTo(PaperRect.Right,Bottom+1);
  376.     end;
  377.     SetBKMode(Handle,Opaque);
  378.     Pen.Style:=psSolid;
  379.     Pen.Mode:=pmCopy;
  380.   end;
  381. end;
  382.  
  383. Function TTeePreviewPage.GetPrintingBitmap:TBitmap;
  384. var tmpR      : TRect;
  385.     WinWidth  : Longint;
  386.     WinHeight : Longint;
  387.     tmpW      : Longint;
  388.     tmpH      : Longint;
  389.     tmpWidth  : Longint;
  390.     tmpHeight : Longint;
  391. begin
  392.   FImage.Printing:=True;
  393.   tmpR:=ImageRect;
  394.   With FImage.GetRectangle do
  395.   begin
  396.     tmpWidth:=Right-Left;
  397.     tmpHeight:=Bottom-Top;
  398.   end;
  399.   FImage.CalcMetaBounds(tmpR,Rect(0,0,tmpWidth,tmpHeight),WinWidth,WinHeight,tmpW,tmpH);
  400.   result:=FImage.TeeCreateBitmap(FPaperColor,Rect(0,0,WinWidth,WinHeight));
  401.   FImage.Printing:=False;
  402. end;
  403.  
  404. Procedure TTeePreviewPage.DrawImage(ACanvas:TCanvas);
  405.  
  406.     Procedure DrawAsBitmap;
  407.     var tmpBitmap : TBitmap;
  408.     begin
  409.       tmpBitmap:=GetPrintingBitmap;
  410.       try
  411.         ACanvas.StretchDraw(ImageRect,tmpBitmap);
  412.       finally
  413.         tmpBitmap.Free;
  414.       end;
  415.     end;
  416.  
  417.     Procedure DrawAsMetafile;
  418.     var tmpR      : TRect;
  419.         tmpMeta   : TMetafile;
  420.         WinWidth  : Longint;
  421.         WinHeight : Longint;
  422.         tmpW      : Longint;
  423.         tmpH      : Longint;
  424.     begin
  425.       tmpR:=ImageRect;
  426.       FImage.CalcMetaBounds(tmpR,FImage.GetRectangle,WinWidth,WinHeight,tmpW,tmpH);
  427.       tmpMeta:=FImage.TeeCreateMetafile(True,Rect(0,0,WinWidth,WinHeight){tmpR});
  428.       try
  429.         ACanvas.StretchDraw(ImageRect,tmpMeta);
  430.       finally
  431.         tmpMeta.Free;
  432.       end;
  433.     end;
  434.  
  435. Begin
  436.   FImage.Printing:=True;
  437.   if FImage.CanClip then ClipCanvas(ACanvas,ImageRect)
  438.                     else ClipCanvas(ACanvas,PaperRect);
  439.   if FShowImage then if AsBitmap then DrawAsBitmap else DrawAsMetafile;
  440.   UnClipCanvas(ACanvas);
  441.   FImage.Printing:=False;
  442. end;
  443.  
  444. Function TTeePreviewPage.WhereIsCursor(x,y:Integer):TeePreviewZones;
  445. Const MinPixels=5;
  446. var xLeft   : Longint;
  447.     xRight  : Longint;
  448.     yTop    : Longint;
  449.     yBottom : Longint;
  450. Begin
  451.   With ImageRect do
  452.   begin
  453.     xLeft  :=Abs(x-Left);
  454.     XRight :=Abs(x-Right);
  455.     yTop   :=Abs(y-Top);
  456.     yBottom:=Abs(y-Bottom);
  457.     if (xLeft<MinPixels)  and (yTop<MinPixels)    then result:=teePrev_LeftTop else
  458.     if (xLeft<MinPixels)  and (yBottom<MinPixels) then result:=teePrev_LeftBottom else
  459.     if (xRight<MinPixels) and (yTop<MinPixels)    then result:=teePrev_RightTop else
  460.     if (xRight<MinPixels) and (yBottom<MinPixels) then result:=teePrev_RightBottom else
  461.     if xLeft<MinPixels   then result:=teePrev_Left else
  462.     if xRight<MinPixels  then result:=teePrev_Right else
  463.     if yTop<MinPixels    then result:=teePrev_Top else
  464.     if yBottom<MinPixels then result:=teePrev_Bottom else
  465.     if PtInRect(ImageRect,Point(x,y)) then
  466.     begin
  467.       if FAllowMove then
  468.       begin
  469.         result:=teePrev_Image;
  470.         exit;
  471.       end else result:=teePrev_None;
  472.     end
  473.     else result:=teePrev_None;
  474.     if (result<>teePrev_None) and (not FAllowResize) then result:=teePrev_None;
  475.   end;
  476. End;
  477.  
  478. Procedure TTeePreviewPage.MouseMove(Shift: TShiftState; X, Y: Integer);
  479. var tmpR        : TRect;
  480.     PaperWidth  : Longint;
  481.     PaperHeight : Longint;
  482. begin
  483.   inherited MouseMove(Shift,X,Y);
  484.   if PtInRect(PaperRect,Point(x,y)) then
  485.   Begin
  486.     if FDragged=teePrev_None then
  487.     begin
  488.       Cursor:=TeePreviewCursors[Ord(WhereIsCursor(x,y))];
  489.       Exit;
  490.     end
  491.     else
  492.     begin
  493.       if not FDragImage then DrawMargins(Canvas);
  494.       Case FDragged of
  495.         { sides }
  496.         teePrev_Left   : if (x>=PaperRect.Left) and (x<ImageRect.Right) then ImageRect.Left:=x;
  497.         teePrev_Top    : if (y>=PaperRect.Top) and (y<ImageRect.Bottom) then ImageRect.Top:=y;
  498.         teePrev_Right  : if (x<=PaperRect.Right) and (x>ImageRect.Left) then ImageRect.Right:=x;
  499.         teePrev_Bottom : if (y<=PaperRect.Bottom) and (y>ImageRect.Top) then ImageRect.Bottom:=y;
  500.         teePrev_Image  : Begin
  501.                            tmpR.Left  :=MaxLong(PaperRect.Left,OldRect.Left+(x-OldX));
  502.                            tmpR.Top   :=MaxLong(PaperRect.Top,OldRect.Top+(y-OldY));
  503.                            tmpR.Right :=MinLong(PaperRect.Right,tmpR.Left+(OldRect.Right-OldRect.Left));
  504.                            tmpR.Bottom:=MinLong(PaperRect.Bottom,tmpR.Top+(OldRect.Bottom-OldRect.Top));
  505.                            if PtInRect(PaperRect,tmpR.TopLeft) and
  506.                               PtInRect(PaperRect,tmpR.BottomRight) then
  507.                                 ImageRect:=tmpR;
  508.                          End;
  509.         { corners }
  510.        teePrev_LeftTop : if (x>=PaperRect.Left) and (x<ImageRect.Right) and
  511.                             (y>=PaperRect.Top) and (y<ImageRect.Bottom) then
  512.                          Begin
  513.                            ImageRect.Left:=x;
  514.                            ImageRect.Top:=y;
  515.                          end;
  516.     teePrev_LeftBottom : if (x>=PaperRect.Left) and (x<ImageRect.Right) and
  517.                             (y<=PaperRect.Bottom) and (y>ImageRect.Top) then
  518.                          Begin
  519.                            ImageRect.Left:=x;
  520.                            ImageRect.Bottom:=y;
  521.                          end;
  522.       teePrev_RightTop : if (x<=PaperRect.Right) and (x>ImageRect.Left) and
  523.                             (y>=PaperRect.Top) and (y<ImageRect.Bottom) then
  524.                          Begin
  525.                            ImageRect.Right:=x;
  526.                            ImageRect.Top:=y;
  527.                          end;
  528.    teePrev_RightBottom : if (x<=PaperRect.Right) and (x>ImageRect.Left) and
  529.                             (y<=PaperRect.Bottom) and (y>ImageRect.Top) then
  530.                          Begin
  531.                            ImageRect.Right:=x;
  532.                            ImageRect.Bottom:=y;
  533.                          end;
  534.       end;
  535.       RectSize(PaperRect,PaperWidth,PaperHeight);
  536.       With FImage.PrintMargins do
  537.       Begin
  538.         Left  :=MulDiv((ImageRect.Left-PaperRect.Left),100,PaperWidth);
  539.         Right :=MulDiv((PaperRect.Right-ImageRect.Right),100,PaperWidth);
  540.         Top   :=MulDiv((ImageRect.Top-PaperRect.Top),100,PaperHeight);
  541.         Bottom:=MulDiv((PaperRect.Bottom-ImageRect.Bottom),100,PaperHeight);
  542.       end;
  543.       if Assigned(FOnChangeMargins) then FOnChangeMargins(Self,True,FImage.PrintMargins);
  544.     end;
  545.   end;
  546. end;
  547.  
  548. procedure TTeePreviewPage.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  549. begin
  550.   inherited MouseUp(Button,Shift,X,Y);
  551.   FDragged:=teePrev_None;
  552.   Invalidate;
  553. end;
  554.  
  555. procedure TTeePreviewPage.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  556. begin
  557.   inherited MouseDown(Button,Shift,X,Y);
  558.   FDragged:=WhereIsCursor(x,y);
  559.   if FDragged=teePrev_Image then
  560.   Begin
  561.     OldX:=x;
  562.     OldY:=y;
  563.     OldRect:=ImageRect;
  564.   end;
  565. end;
  566.  
  567. Procedure TChartPreview.ResetMargins;
  568. begin
  569.   With PreviewPage do
  570.   begin
  571.     if Image.PrintProportional then
  572.     begin
  573.       OldMargins:=Image.CalcProportionalMargins;
  574.       Image.PrintMargins:=OldMargins;
  575.     end;
  576.     RecalcControls;
  577.     PreviewPageChangeMargins(Self,False,Image.PrintMargins);
  578.   end;
  579. end;
  580.  
  581. { Form }
  582. procedure TChartPreview.FormShow(Sender: TObject);
  583. begin
  584.   Screen.Cursor:=crDefault;
  585.   Printers.Items:=Printer.Printers;
  586.   Printers.ItemIndex:=Printer.PrinterIndex;
  587.   {$IFNDEF TEEOCX}
  588.   Printer.Orientation:=poLandscape;
  589.   {$ENDIF}
  590.   With PreviewPage do
  591.   begin
  592.     CBProp.Checked:=Image.PrintProportional;
  593.     Resolution.Position:=Image.PrintResolution;
  594.     OldMargins:=Image.PrintMargins;
  595.     ResetMargins;
  596.   end;
  597.   CreatingForm:=False;
  598. end;
  599.  
  600. procedure TChartPreview.BSetupPrinterClick(Sender: TObject);
  601. begin
  602.   PrinterSetupDialog1.Execute;
  603.   Printers.Items:=Printer.Printers;
  604.   Printers.ItemIndex:=Printer.PrinterIndex;
  605.   RecalcControls;
  606. end;
  607.  
  608. procedure TChartPreview.PrintersChange(Sender: TObject);
  609. begin
  610.   Printer.PrinterIndex:=Printers.ItemIndex;
  611.   RecalcControls;
  612.   OrientationClick(Self);
  613. end;
  614.  
  615. procedure TChartPreview.OrientationClick(Sender: TObject);
  616. begin
  617.   Printer.Orientation:=TPrinterOrientation(Orientation.ItemIndex);
  618.   ResetMargins;
  619.   PreviewPage.Invalidate;
  620. end;
  621.  
  622. procedure TChartPreview.ChangeMargin(UpDown:TUpDown; Var APos:Integer; OtherSide:Integer);
  623. begin
  624.   if not CreatingForm then
  625.   begin
  626.     if UpDown.Position+OtherSide<100 then
  627.     begin
  628.       APos:=UpDown.Position;
  629.       RefreshPage;
  630.     end
  631.     else UpDown.Position:=APos;
  632.   end;
  633. end;
  634.  
  635. procedure TChartPreview.SETopMaChange(Sender: TObject);
  636. begin
  637.   with PreviewPage.Image.PrintMargins do ChangeMargin(UDTopMa,Top,Bottom);
  638. end;
  639.  
  640. procedure TChartPreview.SERightMaChange(Sender: TObject);
  641. begin
  642.   with PreviewPage.Image.PrintMargins do ChangeMargin(UDRightMa,Right,Left);
  643. end;
  644.  
  645. procedure TChartPreview.SEBotMaChange(Sender: TObject);
  646. begin
  647.   with PreviewPage.Image.PrintMargins do ChangeMargin(UDBotMa,Bottom,Top);
  648. end;
  649.  
  650. procedure TChartPreview.SELeftMaChange(Sender: TObject);
  651. begin
  652.   with PreviewPage.Image.PrintMargins do ChangeMargin(UDLeftMa,Left,Right);
  653. end;
  654.  
  655. procedure TChartPreview.WMEraseBkgnd(var Message: TWmEraseBkgnd);
  656. Begin
  657.   if TeeEraseBack then Inherited;
  658.   Message.Result:=1;
  659. End;
  660.  
  661. Procedure TChartPreview.RefreshPage;
  662. Begin
  663.   if not ChangingMargins then
  664.   With PreviewPage do
  665.   Begin
  666.     Invalidate;
  667.     BReset.Enabled:=not EqualRect(Image.PrintMargins,OldMargins);
  668.   end;
  669. end;
  670.  
  671. procedure TChartPreview.ShowMarginsClick(Sender: TObject);
  672. begin
  673.   PreviewPage.ShowMargins:=ShowMargins.Checked;
  674. end;
  675.  
  676. procedure TChartPreview.FormCreate(Sender: TObject);
  677. begin
  678.   CreatingForm:=True;
  679.   ChangingMargins:=True;
  680.   ChangingProp:=False;
  681.   PreviewPage:=TTeePreviewPage.Create(Self);
  682.   With PreviewPage do
  683.   begin
  684.     Parent:=Self;
  685.     Align:=alClient;
  686.     OnChangeMargins:=PreviewPageChangeMargins;
  687.   end;
  688. end;
  689.  
  690. procedure TChartPreview.BResetClick(Sender: TObject);
  691. begin
  692.   With PreviewPage do
  693.   Begin
  694.     Image.PrintMargins:=OldMargins;
  695.     PreviewPageChangeMargins(Self,False,Image.PrintMargins);
  696.   end;
  697. end;
  698.  
  699. Procedure TChartPreview.PreviewPageChangeMargins(Sender:TObject; DisableProportional:Boolean; Const NewMargins:TRect);
  700. Begin
  701.   ChangingMargins:=True;
  702.   try
  703.     UDLeftMa.Position :=NewMargins.Left;
  704.     UDRightMa.Position:=NewMargins.Right;
  705.     UDTopMa.Position  :=NewMargins.Top;
  706.     UDBotMa.Position  :=NewMargins.Bottom;
  707.     if DisableProportional then
  708.     begin
  709.       PreviewPage.Image.PrintProportional:=False;
  710.       ChangingProp:=True;
  711.       CBProp.Checked:=False;
  712.       ChangingProp:=False;
  713.     end;
  714.   finally
  715.     ChangingMargins:=False;
  716.     if PreviewPage.DragImage or (not DisableProportional) then
  717.        RefreshPage
  718.     else
  719.        PreviewPage.DrawMargins(PreviewPage.Canvas);
  720.   end;
  721. end;
  722.  
  723. Procedure TChartPreview.RecalcControls;
  724. Begin
  725.   Orientation.ItemIndex:=Ord(Printer.Orientation);
  726. End;
  727.  
  728. procedure TChartPreview.ResolutionChange(Sender: TObject);
  729. begin
  730.   With PreviewPage do
  731.   Begin
  732.     Image.PrintResolution:=Resolution.Position;
  733.     Invalidate;
  734.   end;
  735.   RecalcControls;
  736. end;
  737.  
  738. procedure TChartPreview.BPrintClick(Sender: TObject);
  739. begin
  740.   Screen.Cursor:=crHourGlass;
  741.   try
  742.     PreviewPage.Print;
  743.   finally
  744.     Screen.Cursor:=crDefault;
  745.   end;
  746. end;
  747.  
  748. procedure TChartPreview.FormDestroy(Sender: TObject);
  749. begin
  750.   PreviewPage.Free;
  751. end;
  752.  
  753. procedure TChartPreview.BCloseClick(Sender: TObject);
  754. begin
  755.   Close;
  756. end;
  757.  
  758. procedure TChartPreview.CBPropClick(Sender: TObject);
  759. begin
  760.   if not ChangingProp then
  761.   begin
  762.     PreviewPage.Image.PrintProportional:=CBProp.Checked;
  763.     ResetMargins;
  764.   end;
  765. end;
  766.  
  767. end.
  768.